home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 September / Software of the Month Club 1996 September.iso / mac / Software Research Institute-SRI / Business / Alpha ƒ / Tcl / SystemCode / indentLine.tcl < prev    next >
Encoding:
Text File  |  1995-12-10  |  5.4 KB  |  181 lines  |  [TEXT/ALFA]
  1. ########################################################################
  2. # Mode-dependent auto-indentation
  3. # (modified from original generic indentLine by Tom Pollard 
  4. # <pollard@chem.columbia.edu>)
  5. #
  6. # 1. 'indentLine' calls the routine ${mode}indentLine, if it exists, 
  7. #      else it reverts to Pete's generic indentLine procedure.
  8. # 2. 'indentRegion' calls the routine ${mode}indentRegion, if it 
  9. #       exists, else it reverts to calling 'indentLine' for each line.
  10. # 3. generic indentLine uses mode-specific comment definition, if it 
  11. #       exists. (defined below for Tcl, Perl, and C)
  12. #
  13.  
  14. # doATab may be called with an optional non-zero argument to override
  15. # its interpretation as 'indent-Line' (doesn't break older usage.)
  16. proc doATab {{hard 0}} {
  17.     global mode
  18.     global ${mode}modeVars
  19.     if {$hard || ([info exists ${mode}modeVars] && 
  20.                   ![set ${mode}modeVars(electricTab)])} {
  21.         if {[getPos] != [selEnd]} {
  22.             replaceText [getPos] [selEnd] "\t"
  23.         } else {
  24.             insertText "\t"
  25.         }
  26.     } else {
  27.         indentLine
  28.     }
  29. }
  30.  
  31. proc indentLine {} {
  32.     global mode    
  33.     if {[catch {${mode}indentLine}]} {
  34. #         message '${mode}indentLine failed - reverting to generic method'
  35.         indentLine0
  36.     }    
  37. }
  38.  
  39. proc indentRegion {} {
  40.     global mode    
  41.     if {[catch {${mode}indentRegion}]} {
  42.         simpleIndentRegion
  43.     }
  44. }
  45.  
  46. proc simpleIndentRegion {} {
  47.     set from [lindex [posToRowCol [getPos]] 0]
  48.     set to [lindex [posToRowCol [selEnd]] 0]
  49.     select [getPos]
  50.     while {$from <= $to} {
  51.         goto [rowColToPos $from 0]
  52.         indentLine
  53.         incr from
  54.     }
  55. }
  56.  
  57. set TclcommentRegexp {^[ \t]*#}
  58. set PerlcommentRegexp {^[ \t]*#}
  59. set cCommentRegexp    {/\*([^*]|[^*]\/|\*[^\/]|\r)*\*/}
  60. set CcommentRegexp $cCommentRegexp
  61. set C++commentRegexp $cCommentRegexp
  62.  
  63. ########################################################################
  64. # Generic C-style indentation (works for Tcl and Perl)
  65. #
  66. proc indentLine0 {} {
  67.     global mode 
  68.     global ${mode}commentRegexp cCommentRegexp
  69.     
  70.     if {[info exists ${mode}commentRegexp]} {
  71.         set comPat [set ${mode}commentRegexp]
  72.     } else {
  73.         set comPat $cCommentRegexp
  74.     }
  75.     set comPat "($comPat|^\[     \]\[    \]*\$)"
  76.     
  77.     set beg [lineStart [getPos]]
  78.     set end [nextLineStart [getPos]]
  79.  
  80.     # Find last previous non-comment line and get its leading whitespace
  81.     set pos $beg
  82.     set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $pos-1]]    
  83.     set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  84.     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  85.     # Find the last preceding comment block
  86.     set prvPos [lindex $lst 0]
  87.     if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $pos-1]} lstCmt]} {
  88.         set begCmt [lindex $lstCmt 0]
  89.         set endCmt [lindex $lstCmt 1]
  90.         # If current non-blank line is in the comment...
  91.         while {$begCmt <= $prvPos && $endCmt >= $prvPos} {
  92.             # ...find the last non-blank line that precedes the comment block,
  93.             if {![catch {search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $begCmt-1]} lst]} {    
  94.                 set prvPos [lindex $lst 0]
  95.                 set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  96.                 set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  97.                 # ...and the next preceding comment block.
  98.                 if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $prvPos]} lstCmt]} {
  99.                     set begCmt [lindex $lstCmt 0]
  100.                     set endCmt [lindex $lstCmt 1]
  101.                 } else {
  102.                     break
  103.                 }
  104.             } else {
  105.                 # Handle search failure at top-of-file
  106.                 set line "#"
  107.                 set lwhite ""
  108.                 break
  109.             }
  110.         }
  111.     }
  112.  
  113. #   This line fails if there's whitespace at the end of the previous line
  114. #    set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  115. #
  116. #    set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  117. #
  118.     regexp {([^ \t])[ \t]*$} $line allofit nextC
  119. #
  120.     if {($nextC == "\{")} {
  121.         append lwhite "\t"
  122.     } elseif {$nextC == ":"} {
  123.         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
  124.     }
  125.         
  126.     set text [getText $beg [nextLineStart $beg]]
  127.     regexp {^[ \t]*} $text white
  128.     set len [string length $white]
  129.     set nextC [lookAt [expr $beg + $len]]
  130.     if {$nextC == "\}"} {
  131.         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  132.     }
  133.  
  134.     if {$white != $lwhite} {
  135.         replaceText $beg [expr $beg + $len] $lwhite
  136.     }
  137.     goto [expr $beg + [string length $lwhite]]
  138. }
  139.  
  140. ########################################################################
  141. # Pete's generic indentLine from v6.02
  142. #
  143. proc C++indentLine {} { CindentLine }
  144. proc CindentLine {} {
  145.     global mode
  146.     
  147.     set beg [lineStart [getPos]]
  148.  
  149.     set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ \t\r]} [expr $beg-1]]
  150.     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  151.     set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  152.  
  153.     if {($nextC == "\{")} {
  154.         append lwhite "\t"
  155.     } elseif {$nextC == ":"} {
  156.         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]\t"
  157.     }
  158.         
  159.     set text [getText $beg [nextLineStart $beg]]
  160.     regexp {^[ \t]*} $text white
  161.     set len [string length $white]
  162.     set nextC [lookAt [expr $beg + $len]]
  163.     if {$nextC == "\}"} {
  164.         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  165.     }
  166.     
  167.     global ${mode}modeVars
  168.     if {[string match "*:\r" $text] && [info exists ${mode}modeVars(elecColon)] && [set ${mode}modeVars(elecColon)]} {
  169.         if {[string index $lwhite 0] == "\t"} {
  170.             set lwhite "[string range $lwhite 1 [expr [string length $lwhite] - 1]]  "
  171.         }
  172.     }
  173.  
  174.     if {$white != $lwhite} {
  175.         replaceText $beg [expr $beg + $len] $lwhite
  176.     }
  177.     goto [expr $beg + [string length $lwhite]]
  178. }
  179.  
  180. ########################################################################
  181.